{- Piffle, Copyright (C) 2007, Jaap Weel. This program is free
   software; you can redistribute it and/or modify it under the terms
   of the GNU General Public License as published by the Free Software
   Foundation; either version 2 of the License, or (at your option)
   any later version.  This program is distributed in the hope that it
   will be useful, but WITHOUT ANY WARRANTY; without even the implied
   warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
   See the GNU General Public License for more details.  You should
   have received a copy of the GNU General Public License along with
   this program; if not, write to the Free Software Foundation, Inc.,
   59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -}

module Main where
import System.IO
import System.Exit
import System.Environment
import Control.Monad (when)
import Regex

import qualified PiffleParse
import qualified PifflePiffle
import qualified PifflePretty
import qualified CIr
import qualified CC
import qualified C
import qualified IrIr
import qualified IrPiffle
import qualified IrPretty
import qualified CPretty
import qualified Path
import PrettyPP
import PrettyUtil (text, colored, pretty)
import Configure
import Compiler
import Position


-- DRIVE COMPILER ----------------------------------------------------

{- This function is the main entry point for pfc running as a
   standalone program. -}

main :: IO ()
main =
    do argv <- getArgs
       interactiveMain argv

{- This function is the main entry point for pfc running interactively
   within ghci. It configures the program based on the command line
   options and invokes the actual compiler. -}

interactiveMain :: [String] -> IO ()
interactiveMain argv = 
    case configure argv of
      Left error ->
          do hPutStrLn stderr error
             exitWith statusCommandLine
      Right config ->
          do compileAndOutput config
             exitWith statusReady


-- COMPILER ----------------------------------------------------------

{- After the program is properly configured, the following function is
   called on a properly prepared object of type Config. It reads the
   appropriate inputs, calls the actual compiler, and writes the
   appropriate outputs. -}

compileAndOutput :: Config -> IO ()
compileAndOutput config =
    do pflName <- return (file config)
       pflText <- readFile pflName
       boilerName <- return (boilerplate config)
       boilerText <- maybe (return "") readBoiler boilerName
       let (output, log) = runCompiler (fakePos pflName) config
                                    (compile pflName pflText) in
         do bark (prettyLogMessages (debug config) log)
            case output of
              Left errorMsg ->
                  do bark (prettyFaultWithQuote pflText errorMsg)
                     exitWith statusCompilerBad
              Right (cName, cText) ->
                  do writeFile cName
                        (assemble config boilerName 
                                  cName boilerText (pp cText))
                     exitWith statusReady
    where
      bark = 
          hPutStr stderr . ppColor (color config)
      readBoiler fnb =
          Path.readFileInSearchPaths fnb
                  [".","/usr/share/piffle","/usr/local/share/piffle"]
                  "PIFFLEBOILER"


{- And finally, the following function is where the actual translation
   happens. -}

compile :: String -> String -> Compiler (String, C.File)
compile pflName pflText = 
    do logMessage 10 [colored 32 $ text pflName]
       p <- PiffleParse.reader pflText pflName
       logMessage 10 [colored 34 $ text "--- PiffleParse.reader ---", pretty p]
       p <- PifflePiffle.tFile p
       logMessage 10 [colored 34 $ text "--- PifflePiffle.tFile ---", pretty p]
       p <- IrPiffle.tFile p
       logMessage 10 [colored 34 $ text"--- IrPiffle.tFile ---", pretty p]
       p <- IrIr.tFile p
       logMessage 10 [colored 34 $ text"--- IrIr.tFile ---", pretty p]
       p <- return $ CIr.tFile p
       logMessage 10 [colored 34 $ text"--- CIr.tFile ---", pretty p]
       p <- return $ CC.tFile p
       logMessage 10 [colored 34 $ text"--- CC.tFile ---", pretty p]
       when (not (grepB "\\.pfl$" pflName)) (die "file name must end in .pfl")
       return (sed "\\.pfl$" pflName ".c", p)


-- HEADER TO INSERT IN OUTPUT ----------------------------------------

assemble :: Config -> Maybe String -> String -> String -> String -> String
assemble config boilerName cName boilerText cText =
    unlines header ++ body
    where 
      banner = 
          [ "/*****************************************************************************",
            " * THIS FILE WAS GENERATED BY PFC, THE PIFFLE COMPILER",
            " * Command line arguments were: " ++ concatMap (++ " ") (argv config),
            " *****************************************************************************/" ]
      header = 
          banner ++ boiler boilerName boilerText
      body =
          "#line " ++ show (length header) ++ " \"" ++ cName ++ "\"\n" ++ cText

boiler :: Maybe String -> String -> [String]
boiler Nothing _ = 
    []
boiler (Just boilerName) boilerText = 
    [ "/*^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^",
      " *                         BEGIN BOILERPLATE",
      " */",
      "#line 1 \"" ++ boilerName ++ "\"" ] ++
    lines boilerText ++
    [ "/*",
      " *                          END BOILERPLATE",
      " *^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*/" ]



-- RETURN STATUS CODES FOR THE PROGRAM -------------------------------

statusReady =
    ExitSuccess
statusCommandLine =
    ExitFailure 1
statusCompilerBad =
    ExitFailure 2

